home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / DELPHI.SWG / 0015_Traversing DIRS in DELPHI.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  2.2 KB  |  80 lines
  1. {=============================================}
  2. {                                             }
  3. { James L. Allison                            }
  4. { 1703 Neptune Lane                           }
  5. { Houston, Texas  77062                       }
  6. { INTERNET:71565.303@compuserve.com           }
  7. {                                             }
  8. { Released to public domain.                  }
  9. { Nov 6, 1994                                 }
  10. {                                             }
  11. {=============================================}
  12.  
  13.  
  14. unit Traverse;
  15. interface
  16.  
  17. uses
  18.   SysUtils;
  19.   {+F}
  20.  
  21. type
  22.   Action = (Finished, FindMore);
  23.   Process_File = function (Path: string; Info: tSearchRec): Action;
  24. {
  25.   Process_File is a user written procedure that does something
  26.   to a file.  It then returns either Finished, telling Walk_Tree
  27.   to quit, or CONTINUE, telling Walk_Tree to keep going.
  28. }
  29.  
  30.  
  31. {
  32.   In the following, start is the path name of the directory where
  33.   traversal is to start.  IT DOES NOT HAVE A TRAILING \ OR A
  34.   FILE PATTERN.
  35. }
  36.  
  37. procedure Walk_Tree(Start: string;
  38.                     Attr: word;          {see FindFirst}
  39.                     Recursive: boolean;  {walk into subtrees}
  40.                     DoIt: Process_File); {called for each hit}
  41.  
  42. (*----------------------------------------------------------------------------*)
  43. implementation
  44.  
  45. (*----------------------------------------------------------------------------*)
  46. procedure Walk_Tree(Start: string;
  47.                     Attr: word;
  48.                     Recursive: boolean;
  49.                     DoIt: Process_File);
  50.  
  51.   const
  52.     FilePattern = '\*.*';
  53.  
  54.   var
  55.     SR: tSearchRec;
  56.     Temp: string;
  57.     Status:integer;
  58.   begin
  59.     if Start[Length(Start)] = '\' then dec(Start[0]); {just in case}
  60.  
  61.     Temp := Start + FilePattern;
  62.     Status:=FindFirst(Temp, Attr, SR);
  63.  
  64.     while Status = 0 do
  65.       begin
  66.         if DoIt(Start, SR) = Finished then EXIT;
  67.  
  68.         if ((SR.Attr and faDirectory) <> 0)
  69.            and (SR.name <> '.')
  70.            and (SR.name <> '..')
  71.            and Recursive
  72.            then Walk_Tree(Start + '\' + SR.name, Attr, Recursive, DoIt);
  73.  
  74.         Status:=FindNext(SR);
  75.       end;
  76.  
  77.   end;
  78.  
  79. end.
  80.